home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / calc.tcl < prev    next >
Encoding:
Text File  |  1999-03-17  |  10.0 KB  |  301 lines  |  [TEXT/ALFA]
  1. ######################################################################
  2. #                                                                    #
  3. #   Use at your own risk. This is just a quick-and-dirty RPN stack   #
  4. #   calculator, works on both decimal (signed and unsigned), hex     #
  5. #   integers, and floating point. I put it                           #
  6. #   together for my own use, not yours, but feel free to use it as   #
  7. #   long as you don't complain about what it doesn't do.             #
  8. #   Improvements, of course, are welcome.                            #
  9. #                                                                    #
  10. #   Operations: Top of stack is 'y', next is 'x'.                    #
  11. #       n              bitwise NOT                                   #
  12. #       +,-,*,/,|,&,%   Does x OP y.                                 #
  13. #       ^              x eor y or                                    #
  14. #               x^y in floating point mode                           #
  15. #       <              x << y                                        #
  16. #       >              x >> y                                        #
  17. #       -  <o>        insert - sign                                  #
  18. #       -  <z>        change y's sign                                #
  19. #       q              dup y                                         #
  20. #       i              swap x and y                                  #
  21. #       m              switch decimal/hex modes                      #
  22. #       x              show current mode                             #
  23. #       h,?          help                                            #
  24. #       <backspace>  pop stack                                       #
  25. #       <space>      enter number                                    #
  26. #                                                                    #
  27. #   Floating point extensions                                        #
  28. #                                                                    #
  29. #       f <o>          floor(y)                                      #
  30. #       f <so>        ceil(y)                                        #
  31. #                                                                    #
  32. #       f <z>          fmod(x,y)                                     #
  33. #       h <z>          hypot(x,y)                                    #
  34. #       p <z>          x**y                                          #
  35. #       s <sz>        sqrt(y)                                        #
  36. #                                                                    #
  37. #       l <z>          log(y)                                        #
  38. #       l <sz>        exp(y)                                         #
  39. #       l <o>          log10(y)                                      #
  40. #                                                                    #
  41. #       c <o>          cos(y)                                        #
  42. #       s <o>          sin(y)                                        #
  43. #       t <o>          tan(y)                                        #
  44. #                                                                    #
  45. #       c <so>        acos(y)                                        #
  46. #       s <so>        asin(y)                                        #
  47. #       t <so>        atan(y)                                        #
  48. #                                                                    #
  49. #       c <z>          cosh(y)                                       #
  50. #       s <z>          sinh(y)                                       #
  51. #       t <z>          tanh(y)                                       #
  52. #                                                                    #
  53. #       t <sz>        atan2(x,y)                                     #
  54. #                                                                    #
  55. #   The mode indicator indicates whether hex or dec is active.       #
  56. #   All calculations performed in signed decimal.                    #
  57. #                                                                    #
  58. ######################################################################
  59.  
  60. alpha::mode Calc 0.1.2 Calc::dummy {} {} {} \
  61.   help {[editMark [file join $HOME Help "Alpha Manual"] "Calculator" -r -c]}
  62.  
  63. # Alpha will shift this in and out of global scope as necessary
  64. newPref variable tcl_precision 17 Calc
  65.  
  66. proc Calc::dummy {} {}
  67.  
  68. proc calculator {} {
  69.     global tileLeft tileTop
  70.     if {[set ind [lsearch -exact [winNames] {* Calc *}]] >= 0} {
  71.         bringToFront {* Calc *}
  72.         return
  73.     }
  74.     new -g $tileLeft $tileTop 200 200 -n {* Calc *} -m Calc -shell 1
  75. }
  76.  
  77. ascii 0x2b "binop +"    Calc
  78. ascii 0x2d "binop -"    Calc
  79. ascii 0x2a "binop *"    Calc
  80. ascii 0x2f "binop /"    Calc
  81. ascii 0x5e "binop ^"    Calc
  82. ascii 0x26 "binop &"    Calc
  83. ascii 0x25 "binop %"    Calc
  84. ascii 0x3e "binop >>"    Calc
  85. ascii 0x3c "binop <<"    Calc
  86. ascii 0x3f "editMark \"[file join $HOME Help {Alpha Manual}]\" Calculator -r -c" Calc
  87. ascii 0x68 "editMark \"[file join $HOME Help {Alpha Manual}]\" Calculator -r -c" Calc
  88. ascii 0x71 calcDup        Calc
  89. ascii 0x69 calcEx        Calc
  90. ascii 0x6d changeCalcMode    Calc
  91. ascii 0x78 "calcShow"    Calc
  92. ascii 0x20 calcEnter    Calc
  93. ascii 0x08 calcDel        Calc
  94. ascii 0x25      "function %"            Calc
  95. ascii 0x5e      "function ^"            Calc
  96. Bind '-' <z>    "unaryop -"                Calc
  97. Bind '-' <o>    { insertText "-" }        Calc
  98. Bind 'l' <os>    "binop |"                Calc
  99. Bind 'n'        "unaryop ~"            Calc
  100.  
  101. Bind 'f' <o>    "unaryop floor"         Calc
  102. Bind 'f' <os>    "unaryop ceil"          Calc
  103. Bind 'f' <z>    "function fmod"         Calc
  104. Bind 'h' <z>    "function hypot"        Calc
  105. Bind 'p' <z>    "function pow"          Calc
  106. Bind 's' <sz>    "unaryop sqrt"            Calc
  107.  
  108. Bind 'l' <z>    "unaryop log"            Calc
  109. Bind 'l' <sz>    "unaryop exp"            Calc
  110. Bind 'l' <o>    "unaryop log10"         Calc
  111.  
  112. Bind 'c' <o>    "unaryop cos"            Calc
  113. Bind 's' <o>    "unaryop sin"            Calc
  114. Bind 't' <o>    "unaryop tan"            Calc
  115. Bind 'c' <os>    "unaryop acos"          Calc
  116. Bind 's' <os>    "unaryop asin"          Calc
  117. Bind 't' <os>    "unaryop atan"          Calc
  118. Bind 'c' <z>    "unaryop cosh"            Calc
  119. Bind 's' <z>    "unaryop sinh"            Calc
  120. Bind 't' <z>    "unaryop tanh"            Calc
  121. Bind 't' <sz>    "function atan2"        Calc
  122.  
  123. Bind 'p' <o> "insertText {3.14159265358979323}" Calc
  124. Bind 'e' <so> "insertText {2.718281828459045}" Calc
  125.  
  126. set calcMode 3
  127.  
  128. proc changeCalcMode {} {
  129.     global calcMode
  130.     
  131.     goto [maxPos]
  132.     if {[pos::compare [getPos] > [minPos]]} {
  133.         if {[lookAt [pos::math [getPos] - 1]] != "\r"} calcEnter
  134.         set nums {}
  135.         set t ""
  136.         foreach n [split [getText [minPos] [pos::math [maxPos] - 1]] "\r"] {
  137.             lappend nums [calcGet $n]
  138.         }
  139.         set calcMode [expr {($calcMode + 1) % 4}]
  140.         foreach n $nums {
  141.             append t "[calcPut $n]\r"
  142.         }
  143.         replaceText [minPos] [maxPos] $t
  144.     } else {
  145.         set calcMode [expr {($calcMode + 1) % 4}]
  146.     }
  147.     switch -- "$calcMode" {
  148.         0     {message "Signed decimal" }
  149.         1     {message "Unsigned decimal"}
  150.         2     {message "Unsigned hexadecimal"}
  151.         3     {message "Floating Point"}
  152.     }
  153. }
  154.  
  155.  
  156. proc calcShow {} {
  157.     global calcMode
  158.     switch -- "$calcMode" {
  159.         0     {message "Signed decimal" }
  160.         1     {message "Unsigned decimal"}
  161.         2     {message "Unsigned hexadecimal"}
  162.         3     {message "Floating Point"}
  163.     }
  164. }
  165.  
  166.  
  167. proc calcGet {in} {
  168.     global calcMode
  169.  
  170.     switch -- "$calcMode" {
  171.         0    {scan $in "%d" num; return $num}
  172.         1    {scan $in "%u" num; return $num}
  173.         2    {scan $in "%x" num; return $num}
  174.         3    {scan $in "%g" num; return $num}
  175.     }
  176.     error "Bad hex num '$in'"
  177. }
  178.  
  179. proc calcPut {in} {
  180.     global calcMode
  181.  
  182.     if {$calcMode != 3} {
  183.         regexp {[0-9-]+} $in in
  184.     }
  185.     switch -- $calcMode {
  186.         0         {return [format "%10d" $in]}
  187.         1         {return [format "%10u" $in]}
  188.         2         {return [format "%10x" $in]}
  189.         3         {return [format "%17.6f" $in]}
  190.     }
  191. }
  192.  
  193.         
  194. proc binop {op} {
  195.     global calcMode
  196.     if {$calcMode == 3 && ($op == "&" || $op == "|" \
  197.       || $op == "<<" || $op == ">>")} {
  198.         beep
  199.         message "${op} does not work in floating point mode"
  200.         return
  201.     }
  202.     goto [maxPos]
  203.     if {[lookAt [pos::math [getPos] - 1]] != "\r"} calcEnter
  204.     set pos [lineStart [getPos]]
  205.     set st_y [lineStart [pos::math $pos - 1]]
  206.     set st_x [lineStart [pos::math $st_y - 1]]
  207.     if {[pos::compare $st_y == $st_x]} { beep; return}
  208.     set res [eval expr {[calcGet [getText $st_x $st_y]] $op \
  209.                             [calcGet [getText $st_y $pos]]}]
  210.     replaceText $st_x [maxPos] [calcPut $res] "\r"
  211. }
  212.  
  213. proc unaryop {op} {
  214.     global calcMode
  215.     if {$calcMode != 3 && $op != "-" && $op != "~"} {
  216.         beep
  217.         message "${op} works only in floating point mode"
  218.         return
  219.     }
  220.     goto [maxPos]
  221.     
  222.     set pos [getPos]
  223.     set last [lineStart [pos::math [getPos] - 1]]
  224.     set res [eval expr "${op}([calcGet [getText $last $pos]])"]
  225.     replaceText $last $pos [calcPut $res] "\r"
  226. }
  227.  
  228. proc function {op} {
  229.     global calcMode
  230.     if {$calcMode != 3} {
  231.         if { $op == "^" || $op == "%"} {
  232.             binop $op
  233.             return
  234.         }
  235.         beep
  236.         message "${op} works only in floating point mode"
  237.         return
  238.     }
  239.     if { $op == "^" } {set op "pow"}
  240.     if { $op == "%" } {set op "fmod"}
  241.     goto [maxPos]
  242.     if {[lookAt [pos::math [getPos] - 1]] != "\r"} calcEnter
  243.     set pos [lineStart [getPos]]
  244.     set st_y [lineStart [pos::math $pos - 1]]
  245.     set st_x [lineStart [pos::math $st_y - 1]]
  246.     if {[pos::compare $st_y == $st_x]} { beep; return}
  247.     set res [eval expr "${op}([calcGet [getText $st_x $st_y]],\
  248.       [calcGet [getText $st_y $pos]])"]
  249.     replaceText $st_x [maxPos] "[calcPut $res]\r"
  250. }
  251.  
  252. proc calcEx {} {
  253.     goto [maxPos]
  254.     if {[lookAt [pos::math [getPos] - 1]] != "\r"} calcEnter
  255.     set pos [lineStart [getPos]]
  256.     set st_y [lineStart [pos::math $pos - 1]]
  257.     set st_x [lineStart [pos::math $st_y - 1]]
  258.     if {[pos::compare $st_y == $st_x]} { beep; return}
  259.     replaceText $st_x [maxPos] "[getText $st_y $pos][getText $st_x $st_y]"
  260. }
  261.  
  262.  
  263. proc calcEnter {} {
  264.     global calcMode
  265.     goto [maxPos]
  266.     switch -- "$calcMode" {
  267.         0     {set ex {[0-9-]+$}}
  268.         1     {set ex {[0-9]+$}}
  269.         2     {set ex {[0-9a-f]+$}}
  270.         3     {set ex {[eE0-9.-]+$}}
  271.     } 
  272.     if {[regexp -- $ex [getText [lineStart [getPos]] [getPos]] num]} {
  273.         set num [calcGet $num]
  274.         replaceText [lineStart [getPos]] [getPos] [calcPut $num] "\r"
  275.     } else {
  276.         beep
  277.         beginningOfLine
  278.         killLine
  279.     }
  280. }
  281.  
  282. proc calcDel {} {
  283.     goto [maxPos]
  284.     if {[lookAt [pos::math [getPos] - 1]] == "\r"} {
  285.         deleteText [lineStart [pos::math [getPos] - 1]] [getPos]
  286.     } else {
  287.         backSpace
  288.     }
  289. }
  290.  
  291. proc calcDup {} {
  292.     goto [maxPos]
  293.     if {[lookAt [pos::math [getPos] - 1]] != "\r"} calcEnter
  294.     set to [lineStart [getPos]]
  295.     set from [lineStart [pos::math $to - 1]]
  296.     set t [getText $from $to]
  297.     insertText $t
  298. }
  299.  
  300.  
  301.